home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / spline11 / splinapp.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-08-31  |  18.3 KB  |  579 lines

  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00FFFFFF&
  4.    Caption         =   "This is Splinal App!"
  5.    ClientHeight    =   6630
  6.    ClientLeft      =   2745
  7.    ClientTop       =   1800
  8.    ClientWidth     =   5970
  9.    Height          =   7035
  10.    Icon            =   SPLINAPP.FRX:0000
  11.    Left            =   2685
  12.    LinkMode        =   1  'Source
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   6630
  15.    ScaleWidth      =   5970
  16.    Top             =   1455
  17.    Width           =   6090
  18.    Begin CommandButton btnAbout 
  19.       Caption         =   "&About..."
  20.       Height          =   435
  21.       Left            =   4410
  22.       TabIndex        =   27
  23.       Top             =   6090
  24.       Width           =   1275
  25.    End
  26.    Begin CommandButton btnExit 
  27.       Caption         =   "E&xit"
  28.       Height          =   435
  29.       Left            =   2940
  30.       TabIndex        =   24
  31.       Top             =   5535
  32.       Width           =   1275
  33.    End
  34.    Begin CommandButton btnReset 
  35.       Caption         =   "&Reset"
  36.       Height          =   435
  37.       Left            =   4410
  38.       TabIndex        =   9
  39.       Top             =   5535
  40.       Width           =   1275
  41.    End
  42.    Begin Frame ParameterFrame 
  43.       BackColor       =   &H00FFFFFF&
  44.       Caption         =   "Parameters"
  45.       Height          =   2025
  46.       Left            =   2910
  47.       TabIndex        =   17
  48.       Top             =   3255
  49.       Width           =   2775
  50.       Begin SpinButton spinBias 
  51.          Delay           =   50
  52.          Enabled         =   0   'False
  53.          Height          =   285
  54.          Left            =   2415
  55.          Top             =   1440
  56.          Width           =   225
  57.       End
  58.       Begin SpinButton spinTension 
  59.          Delay           =   50
  60.          Enabled         =   0   'False
  61.          Height          =   285
  62.          Left            =   2415
  63.          Top             =   1080
  64.          Width           =   225
  65.       End
  66.       Begin SpinButton spinResolution 
  67.          Delay           =   50
  68.          Height          =   285
  69.          Left            =   2415
  70.          Top             =   720
  71.          Width           =   225
  72.       End
  73.       Begin TextBox txtBias 
  74.          Enabled         =   0   'False
  75.          Height          =   285
  76.          Left            =   1680
  77.          TabIndex        =   8
  78.          Top             =   1440
  79.          Width           =   750
  80.       End
  81.       Begin TextBox txtTension 
  82.          Enabled         =   0   'False
  83.          Height          =   285
  84.          Left            =   1680
  85.          TabIndex        =   7
  86.          Top             =   1080
  87.          Width           =   750
  88.       End
  89.       Begin TextBox txtResolution 
  90.          Height          =   285
  91.          Left            =   1680
  92.          TabIndex        =   6
  93.          Top             =   720
  94.          Width           =   750
  95.       End
  96.       Begin Label lblNumPointsLabel 
  97.          Alignment       =   1  'Right Justify
  98.          BackColor       =   &H00FFFFFF&
  99.          Caption         =   "Number of Points:"
  100.          Height          =   285
  101.          Left            =   15
  102.          TabIndex        =   23
  103.          Top             =   360
  104.          Width           =   1575
  105.       End
  106.       Begin Label lblResolution 
  107.          Alignment       =   1  'Right Justify
  108.          BackColor       =   &H00FFFFFF&
  109.          Caption         =   "Resolution:"
  110.          Height          =   240
  111.          Left            =   15
  112.          TabIndex        =   22
  113.          Top             =   720
  114.          Width           =   1605
  115.       End
  116.       Begin Label lblTension 
  117.          Alignment       =   1  'Right Justify
  118.          BackColor       =   &H00FFFFFF&
  119.          Caption         =   "Tension:"
  120.          Enabled         =   0   'False
  121.          Height          =   270
  122.          Left            =   15
  123.          TabIndex        =   21
  124.          Top             =   1080
  125.          Width           =   1575
  126.       End
  127.       Begin Label lblBias 
  128.          Alignment       =   1  'Right Justify
  129.          BackColor       =   &H00FFFFFF&
  130.          Caption         =   "Bias:"
  131.          Enabled         =   0   'False
  132.          Height          =   270
  133.          Left            =   15
  134.          TabIndex        =   20
  135.          Top             =   1440
  136.          Width           =   1575
  137.       End
  138.       Begin Label lblNumPoints 
  139.          Caption         =   "###"
  140.          Height          =   285
  141.          Left            =   1680
  142.          TabIndex        =   19
  143.          Top             =   360
  144.          Width           =   960
  145.       End
  146.    End
  147.    Begin Frame TypeFrame 
  148.       BackColor       =   &H00FFFFFF&
  149.       Caption         =   "Curve Type"
  150.       Height          =   2685
  151.       Left            =   315
  152.       TabIndex        =   11
  153.       Top             =   3255
  154.       Width           =   2535
  155.       Begin PictureBox picCurveColor 
  156.          Height          =   255
  157.          Index           =   6
  158.          Left            =   1950
  159.          ScaleHeight     =   225
  160.          ScaleWidth      =   345
  161.          TabIndex        =   18
  162.          Top             =   710
  163.          Width           =   375
  164.       End
  165.       Begin CheckBox chkCurveType 
  166.          BackColor       =   &H00FFFFFF&
  167.          Caption         =   "Control &Points"
  168.          Height          =   255
  169.          Index           =   6
  170.          Left            =   120
  171.          TabIndex        =   4
  172.          Top             =   710
  173.          Value           =   1  'Checked
  174.          Width           =   1575
  175.       End
  176.       Begin PictureBox picCurveColor 
  177.          Height          =   255
  178.          Index           =   5
  179.          Left            =   1950
  180.          ScaleHeight     =   225
  181.          ScaleWidth      =   345
  182.          TabIndex        =   16
  183.          Top             =   2160
  184.          Width           =   375
  185.       End
  186.       Begin CommonDialog CMDialog1 
  187.          Left            =   1890
  188.          Top             =   2415
  189.       End
  190.       Begin CheckBox chkCurveType 
  191.          BackColor       =   &H00FFFFFF&
  192.          Caption         =   "&Tau"
  193.          Height          =   255
  194.          Index           =   5
  195.          Left            =   120
  196.          TabIndex        =   5
  197.          Top             =   2160
  198.          Width           =   1095
  199.       End
  200.       Begin PictureBox picCurveColor 
  201.          Height          =   255
  202.          Index           =   4
  203.          Left            =   1950
  204.          ScaleHeight     =   225
  205.          ScaleWidth      =   345
  206.          TabIndex        =   15
  207.          Top             =   1800
  208.          Width           =   375
  209.       End
  210.       Begin CheckBox chkCurveType 
  211.          BackColor       =   &H00FFFFFF&
  212.          Caption         =   "B&eta"
  213.          Height          =   255
  214.          Index           =   4
  215.          Left            =   120
  216.          TabIndex        =   3
  217.          Top             =   1800
  218.          Width           =   1215
  219.       End
  220.       Begin PictureBox picCurveColor 
  221.          Height          =   255
  222.          Index           =   3
  223.          Left            =   1950
  224.          ScaleHeight     =   225
  225.          ScaleWidth      =   345
  226.          TabIndex        =   14
  227.          Top             =   1440
  228.          Width           =   375
  229.       End
  230.       Begin CheckBox chkCurveType 
  231.          BackColor       =   &H00FFFFFF&
  232.          Caption         =   "&Bspline"
  233.          Height          =   255
  234.          Index           =   3
  235.          Left            =   120
  236.          TabIndex        =   2
  237.          Top             =   1440
  238.          Width           =   1215
  239.       End
  240.       Begin PictureBox picCurveColor 
  241.          Height          =   255
  242.          Index           =   2
  243.          Left            =   1950
  244.          ScaleHeight     =   225
  245.          ScaleWidth      =   345
  246.          TabIndex        =   13
  247.          Top             =   1080
  248.          Width           =   375
  249.       End
  250.       Begin CheckBox chkCurveType 
  251.          BackColor       =   &H00FFFFFF&
  252.          Caption         =   "Be&zier"
  253.          Height          =   255
  254.          Index           =   2
  255.          Left            =   120
  256.          TabIndex        =   1
  257.          Top             =   1080
  258.          Width           =   1110
  259.       End
  260.       Begin PictureBox picCurveColor 
  261.          Height          =   255
  262.          Index           =   0
  263.          Left            =   1950
  264.          ScaleHeight     =   225
  265.          ScaleWidth      =   345
  266.          TabIndex        =   12
  267.          Top             =   360
  268.          Width           =   375
  269.       End
  270.       Begin CheckBox chkCurveType 
  271.          BackColor       =   &H00FFFFFF&
  272.          Caption         =   "&Control Polygon"
  273.          Height          =   255
  274.          Index           =   0
  275.          Left            =   120
  276.          TabIndex        =   0
  277.          Top             =   360
  278.          Value           =   1  'Checked
  279.          Width           =   1725
  280.       End
  281.    End
  282.    Begin PictureBox picDisplay 
  283.       AutoRedraw      =   -1  'True
  284.       Height          =   2955
  285.       Left            =   315
  286.       ScaleHeight     =   195
  287.       ScaleMode       =   3  'Pixel
  288.       ScaleWidth      =   357
  289.       TabIndex        =   10
  290.       TabStop         =   0   'False
  291.       Top             =   210
  292.       Width           =   5385
  293.       Begin Label lblOdom 
  294.          Alignment       =   2  'Center
  295.          BorderStyle     =   1  'Fixed Single
  296.          Height          =   225
  297.          Left            =   4320
  298.          TabIndex        =   25
  299.          Top             =   2625
  300.          Width           =   960
  301.       End
  302.    End
  303.    Begin Label Label1 
  304.       Caption         =   "Click left button to add new point.  Click right button to delete last point."
  305.       Height          =   435
  306.       Left            =   210
  307.       TabIndex        =   26
  308.       Top             =   6165
  309.       Width           =   3270
  310.    End
  311. 'Copyright (C) Andrew S. Dean 1993-95
  312. Option Explicit
  313. Const idxControlPolygon = 0
  314. Const idxHermite = 1
  315. Const idxBezier = 2
  316. Const idxBspline = 3
  317. Const idxBeta = 4
  318. Const idxTau = 5
  319. Const idxControlPoints = 6
  320. Const EM_AddPoint = 0
  321. Const EM_MovePoint = 1
  322. Const EM_DeletePoint = 2
  323. ' Use this to determine whether left or right
  324. ' mouse button was clicked in display.
  325. Dim giButton As Integer
  326. Sub AddControlPoint (fx As Single, fy As Single, fz As Single)
  327.    glNumControlPoints = glNumControlPoints + 1
  328.    ' Add the new point to the control polygon.
  329.    ControlPoly(glNumControlPoints).fx = fx
  330.    ControlPoly(glNumControlPoints).fy = fy
  331.    ControlPoly(glNumControlPoints).fz = fz
  332.    ' Update the text value.
  333.    lblNumPoints.Caption = Str$(glNumControlPoints)
  334. End Sub
  335. Sub btnAbout_Click ()
  336.   frmAbout.Show MODAL
  337. End Sub
  338. Sub btnExit_Click ()
  339.   End
  340. End Sub
  341. Sub btnReset_Click ()
  342.   glNumControlPoints = 0
  343.   lblNumPoints.Caption = Str$(glNumControlPoints)
  344.   picDisplay.Cls
  345. End Sub
  346. Sub chkCurveType_Click (Index As Integer)
  347.    picDisplay.Cls
  348.    DrawAllActiveCurves
  349.    If (chkCurveType(idxBeta).Value = CHECKED) Then
  350.       txtTension.Enabled = True
  351.       txtBias.Enabled = True
  352.       lblTension.Enabled = True
  353.       lblBias.Enabled = True
  354.       spinTension.Enabled = True
  355.       spinBias.Enabled = True
  356.    ElseIf (chkCurveType(idxTau).Value = CHECKED) Then
  357.       txtTension.Enabled = True
  358.       txtBias.Enabled = True
  359.       lblTension.Enabled = True
  360.       lblBias.Enabled = True
  361.       spinTension.Enabled = True
  362.       spinBias.Enabled = True
  363.    ElseIf (chkCurveType(idxBspline).Value = CHECKED) Then
  364.       txtTension.Enabled = True
  365.       txtBias.Enabled = False
  366.       lblTension.Enabled = True
  367.       lblBias.Enabled = False
  368.       spinTension.Enabled = True
  369.       spinBias.Enabled = False
  370.    Else
  371.       txtTension.Enabled = False
  372.       txtBias.Enabled = False
  373.       lblTension.Enabled = False
  374.       lblBias.Enabled = False
  375.       spinTension.Enabled = False
  376.       spinBias.Enabled = False
  377.    End If
  378. End Sub
  379. Sub DeleteLastPoint ()
  380.    If (glNumControlPoints = 0) Then
  381.       Exit Sub
  382.    End If
  383.    glNumControlPoints = glNumControlPoints - 1
  384.    ' Update the text value.
  385.    lblNumPoints.Caption = Str$(glNumControlPoints)
  386. End Sub
  387. Sub Delta (C As TextBox, dDelta As Double)
  388.    Dim dVal As Double
  389.    dVal = Val(C.Text)
  390.    dVal = dVal + dDelta
  391.    C.Text = Format(dVal)
  392. End Sub
  393. Sub DrawAllActiveCurves ()
  394.    If (glNumControlPoints <= 0) Then
  395.       Exit Sub
  396.    End If
  397.    If chkCurveType(idxControlPolygon).Value = CHECKED Then
  398.       DrawControl
  399.    End If
  400.    If chkCurveType(idxBspline).Value = CHECKED Then
  401.       DrawBspline
  402.    End If
  403.    If chkCurveType(idxBezier).Value = CHECKED Then
  404.       DrawBezier
  405.    End If
  406.    If chkCurveType(idxBeta).Value = CHECKED Then
  407.       DrawBeta
  408.    End If
  409.    If chkCurveType(idxTau).Value = CHECKED Then
  410.       DrawTau
  411.    End If
  412.    If chkCurveType(idxControlPoints).Value = CHECKED Then
  413.       DrawControlPoints
  414.    End If
  415. End Sub
  416. Sub DrawBeta ()
  417.    Dim I         As Long
  418.    Dim lCurveLen As Long
  419.    ' Call DLL function to compute spline points.
  420.    lCurveLen = BetaSpline(glCurveResolution, gfTension, gfBias, glNumControlPoints, ControlPoly(0), Curve(0))
  421.    'Label4 = lCurveLen
  422.    ' Draw the spline.
  423.    picDisplay.CurrentX = Curve(0).fx
  424.    picDisplay.CurrentY = Curve(0).fy
  425.    For I = 1 To lCurveLen
  426.       picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBeta).BackColor
  427.    Next I
  428. End Sub
  429. Sub DrawBezier ()
  430.    Dim I         As Long
  431.    Dim lCurveLen As Long
  432.    ' Call DLL function to compute spline points.
  433.    lCurveLen = Bezier(glCurveResolution, glNumControlPoints, ControlPoly(0), Curve(0))
  434.    'Label3 = lCurveLen
  435.    ' Draw the spline.
  436.    picDisplay.CurrentX = Curve(0).fx
  437.    picDisplay.CurrentY = Curve(0).fy
  438.    For I = 1 To lCurveLen
  439.       picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBezier).BackColor
  440.    Next I
  441. End Sub
  442. Sub DrawBspline ()
  443.    Dim I         As Long
  444.    Dim lCurveLen As Long
  445.    ' Call DLL function to compute spline points.
  446.    lCurveLen = Bspline(glCurveResolution, gfTension, glNumControlPoints, ControlPoly(0), Curve(0))
  447.    'Label2 = lCurveLen
  448.    ' Draw the spline.
  449.    picDisplay.CurrentX = Curve(0).fx
  450.    picDisplay.CurrentY = Curve(0).fy
  451.    For I = 1 To lCurveLen
  452.       picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBspline).BackColor
  453.    Next I
  454. End Sub
  455. Sub DrawControl ()
  456.    Dim I As Long
  457.    picDisplay.CurrentX = ControlPoly(1).fx
  458.    picDisplay.CurrentY = ControlPoly(1).fy
  459.    For I = 2 To glNumControlPoints
  460.        picDisplay.Line -(ControlPoly(I).fx, ControlPoly(I).fy), picCurveColor(idxControlPolygon).BackColor
  461.    Next I
  462. End Sub
  463. Sub DrawControlPoints ()
  464.    Dim I As Long
  465.    ' Display all the current control points.
  466.    ' Note: Would it be better to use a shape control?
  467.    '       What would be easier for moving/dragging?  I
  468.    '       don't think it matters much for deleting.
  469.    For I = 1 To glNumControlPoints
  470.      picDisplay.Circle (ControlPoly(I).fx, ControlPoly(I).fy), 3, picCurveColor(idxControlPoints).BackColor
  471.    Next I
  472. End Sub
  473. Sub DrawTau ()
  474.    Dim I         As Long
  475.    Dim lCurveLen As Long
  476.    ' Call DLL function to compute spline points.
  477.    lCurveLen = TauSpline(glCurveResolution, gfTension, gfBias, glNumControlPoints, ControlPoly(0), Curve(0))
  478.    'Label5 = lCurveLen
  479.    ' Draw the spline.
  480.    picDisplay.CurrentX = Curve(0).fx
  481.    picDisplay.CurrentY = Curve(0).fy
  482.    For I = 1 To lCurveLen
  483.       picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxTau).BackColor
  484.    Next I
  485. End Sub
  486. Sub Form_Load ()
  487.    CenterForm Form1
  488.    ' Initial line colors.
  489.    picCurveColor(idxControlPolygon).BackColor = RGB(255, 0, 0)
  490.    picCurveColor(idxBezier).BackColor = RGB(0, 255, 0)
  491.    picCurveColor(idxBspline).BackColor = RGB(0, 0, 255)
  492.    picCurveColor(idxTau).BackColor = RGB(0, 255, 255)
  493.    picCurveColor(idxBeta).BackColor = RGB(255, 0, 255)
  494.    picCurveColor(idxControlPoints).BackColor = RGB(0, 0, 0)
  495.    ' Initial parameter values.
  496.    glNumControlPoints = 0
  497.    lblNumPoints.Caption = Str$(glNumControlPoints)
  498.    glCurveResolution = 10
  499.    txtResolution.Text = Str$(glCurveResolution)
  500.    gfTension = 1#
  501.    txtTension.Text = Str$(gfTension)
  502.    gfBias = 1#
  503.    txtBias.Text = Str$(gfBias)
  504. End Sub
  505. Sub picCurveColor_Click (Index As Integer)
  506.    CMDialog1.Color = &HFF&
  507.    CMDialog1.Flags = CC_RGBINIT
  508.    ' Display color dialog
  509.    CMDialog1.Action = 3
  510.    ' Set the pic color
  511.    picCurveColor(Index).BackColor = CMDialog1.Color
  512.    picDisplay.Cls
  513.    DrawAllActiveCurves
  514. End Sub
  515. Sub picDisplay_Click ()
  516.    If (giButton = LEFT_BUTTON) Then
  517.        AddControlPoint CSng(picDisplay.CurrentX), CSng(picDisplay.CurrentY), 0#
  518.        picDisplay.Cls
  519.    Else
  520.        DeleteLastPoint
  521.        picDisplay.Cls
  522.    End If
  523.    DrawAllActiveCurves
  524. End Sub
  525. Sub picDisplay_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  526.    ' Update the Current coordinates whenever the mouse
  527.    ' is down.  Current* can then be used in the click.
  528.    picDisplay.CurrentX = X
  529.    picDisplay.CurrentY = Y
  530.    ' If the right mouse button went down, set up to delete the last control
  531.    ' point.  This is a Q&D undo function.
  532.    giButton = Button
  533. End Sub
  534. Sub picDisplay_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  535.    Dim szOdom As String
  536.    szOdom = "(" & X & "," & Y & ")"
  537.    lblOdom.Caption = szOdom
  538. End Sub
  539. Sub picDisplay_Paint ()
  540.    DrawAllActiveCurves
  541. End Sub
  542. Sub spinBias_SpinDown ()
  543.   Delta txtBias, -.1
  544. End Sub
  545. Sub spinBias_SpinUp ()
  546.   Delta txtBias, .1
  547. End Sub
  548. Sub spinResolution_SpinDown ()
  549.   Delta txtResolution, -1
  550. End Sub
  551. Sub spinResolution_SpinUp ()
  552.   Delta txtResolution, 1
  553. End Sub
  554. Sub spinTension_SpinDown ()
  555.   Delta txtTension, -.1
  556. End Sub
  557. Sub spinTension_SpinUp ()
  558.   Delta txtTension, .1
  559. End Sub
  560. Sub txtBias_Change ()
  561.    gfBias = Val(txtBias.Text)
  562.    picDisplay.Cls
  563.    DrawAllActiveCurves
  564. End Sub
  565. Sub txtResolution_Change ()
  566.    glCurveResolution = Val(txtResolution.Text)
  567.    If (glCurveResolution <= 0) Then
  568.      MsgBox "Resolution must be a positive number."
  569.      Exit Sub
  570.    End If
  571.    picDisplay.Cls
  572.    DrawAllActiveCurves
  573. End Sub
  574. Sub txtTension_Change ()
  575.    gfTension = Val(txtTension.Text)
  576.    picDisplay.Cls
  577.    DrawAllActiveCurves
  578. End Sub
  579.